home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / DB.pm < prev    next >
Text File  |  2008-07-24  |  19KB  |  810 lines
  1. #
  2. # Documentation is at the __END__
  3. #
  4.  
  5. package DB;
  6.  
  7. # "private" globals
  8.  
  9. my ($running, $ready, $deep, $usrctxt, $evalarg, 
  10.     @stack, @saved, @skippkg, @clients);
  11. my $preeval = {};
  12. my $posteval = {};
  13. my $ineval = {};
  14.  
  15. ####
  16. #
  17. # Globals - must be defined at startup so that clients can refer to 
  18. # them right after a C<require DB;>
  19. #
  20. ####
  21.  
  22. BEGIN {
  23.  
  24.   # these are hardcoded in perl source (some are magical)
  25.  
  26.   $DB::sub = '';        # name of current subroutine
  27.   %DB::sub = ();        # "filename:fromline-toline" for every known sub
  28.   $DB::single = 0;      # single-step flag (set it to 1 to enable stops in BEGIN/use)
  29.   $DB::signal = 0;      # signal flag (will cause a stop at the next line)
  30.   $DB::trace = 0;       # are we tracing through subroutine calls?
  31.   @DB::args = ();       # arguments of current subroutine or @ARGV array
  32.   @DB::dbline = ();     # list of lines in currently loaded file
  33.   %DB::dbline = ();     # actions in current file (keyed by line number)
  34.   @DB::ret = ();        # return value of last sub executed in list context
  35.   $DB::ret = '';        # return value of last sub executed in scalar context
  36.  
  37.   # other "public" globals  
  38.  
  39.   $DB::package = '';    # current package space
  40.   $DB::filename = '';   # current filename
  41.   $DB::subname = '';    # currently executing sub (fullly qualified name)
  42.   $DB::lineno = '';     # current line number
  43.  
  44.   $DB::VERSION = $DB::VERSION = '1.01';
  45.  
  46.   # initialize private globals to avoid warnings
  47.  
  48.   $running = 1;         # are we running, or are we stopped?
  49.   @stack = (0);
  50.   @clients = ();
  51.   $deep = 100;
  52.   $ready = 0;
  53.   @saved = ();
  54.   @skippkg = ();
  55.   $usrctxt = '';
  56.   $evalarg = '';
  57. }
  58.  
  59. ####
  60. # entry point for all subroutine calls
  61. #
  62. sub sub {
  63.   push(@stack, $DB::single);
  64.   $DB::single &= 1;
  65.   $DB::single |= 4 if $#stack == $deep;
  66.   if ($DB::sub eq 'DESTROY' or substr($DB::sub, -9) eq '::DESTROY' or not defined wantarray) {
  67.     &$DB::sub;
  68.     $DB::single |= pop(@stack);
  69.     $DB::ret = undef;
  70.   }
  71.   elsif (wantarray) {
  72.     @DB::ret = &$DB::sub;
  73.     $DB::single |= pop(@stack);
  74.     @DB::ret;
  75.   }
  76.   else {
  77.     $DB::ret = &$DB::sub;
  78.     $DB::single |= pop(@stack);
  79.     $DB::ret;
  80.   }
  81. }
  82.  
  83. ####
  84. # this is called by perl for every statement
  85. #
  86. sub DB {
  87.   return unless $ready;
  88.   &save;
  89.   ($DB::package, $DB::filename, $DB::lineno) = caller;
  90.  
  91.   return if @skippkg and grep { $_ eq $DB::package } @skippkg;
  92.  
  93.   $usrctxt = "package $DB::package;";        # this won't let them modify, alas
  94.   local(*DB::dbline) = "::_<$DB::filename";
  95.  
  96.   # we need to check for pseudofiles on Mac OS (these are files
  97.   # not attached to a filename, but instead stored in Dev:Pseudo)
  98.   # since this is done late, $DB::filename will be "wrong" after
  99.   # skippkg
  100.   if ($^O eq 'MacOS' && $#DB::dbline < 0) {
  101.     $DB::filename = 'Dev:Pseudo';
  102.     *DB::dbline = "::_<$DB::filename";
  103.   }
  104.  
  105.   my ($stop, $action);
  106.   if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) {
  107.     if ($stop eq '1') {
  108.       $DB::signal |= 1;
  109.     }
  110.     else {
  111.       $stop = 0 unless $stop;            # avoid un_init warning
  112.       $evalarg = "\$DB::signal |= do { $stop; }"; &eval;
  113.       $DB::dbline{$DB::lineno} =~ s/;9($|\0)/$1/;    # clear any temp breakpt
  114.     }
  115.   }
  116.   if ($DB::single || $DB::trace || $DB::signal) {
  117.     $DB::subname = ($DB::sub =~ /\'|::/) ? $DB::sub : "${DB::package}::$DB::sub"; #';
  118.     DB->loadfile($DB::filename, $DB::lineno);
  119.   }
  120.   $evalarg = $action, &eval if $action;
  121.   if ($DB::single || $DB::signal) {
  122.     _outputall($#stack . " levels deep in subroutine calls.\n") if $DB::single & 4;
  123.     $DB::single = 0;
  124.     $DB::signal = 0;
  125.     $running = 0;
  126.     
  127.     &eval if ($evalarg = DB->prestop);
  128.     my $c;
  129.     for $c (@clients) {
  130.       # perform any client-specific prestop actions
  131.       &eval if ($evalarg = $c->cprestop);
  132.       
  133.       # Now sit in an event loop until something sets $running
  134.       do {
  135.     $c->idle;                     # call client event loop; must not block
  136.     if ($running == 2) {          # client wants something eval-ed
  137.       &eval if ($evalarg = $c->evalcode);
  138.       $running = 0;
  139.     }
  140.       } until $running;
  141.       
  142.       # perform any client-specific poststop actions
  143.       &eval if ($evalarg = $c->cpoststop);
  144.     }
  145.     &eval if ($evalarg = DB->poststop);
  146.   }
  147.   ($@, $!, $,, $/, $\, $^W) = @saved;
  148.   ();
  149. }
  150.   
  151. ####
  152. # this takes its argument via $evalarg to preserve current @_
  153. #    
  154. sub eval {
  155.   ($@, $!, $,, $/, $\, $^W) = @saved;
  156.   eval "$usrctxt $evalarg; &DB::save";
  157.   _outputall($@) if $@;
  158. }
  159.  
  160. ###############################################################################
  161. #         no compile-time subroutine call allowed before this point           #
  162. ###############################################################################
  163.  
  164. use strict;                # this can run only after DB() and sub() are defined
  165.  
  166. sub save {
  167.   @saved = ($@, $!, $,, $/, $\, $^W);
  168.   $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
  169. }
  170.  
  171. sub catch {
  172.   for (@clients) { $_->awaken; }
  173.   $DB::signal = 1;
  174.   $ready = 1;
  175. }
  176.  
  177. ####
  178. #
  179. # Client callable (read inheritable) methods defined after this point
  180. #
  181. ####
  182.  
  183. sub register {
  184.   my $s = shift;
  185.   $s = _clientname($s) if ref($s);
  186.   push @clients, $s;
  187. }
  188.  
  189. sub done {
  190.   my $s = shift;
  191.   $s = _clientname($s) if ref($s);
  192.   @clients = grep {$_ ne $s} @clients;
  193.   $s->cleanup;
  194. #  $running = 3 unless @clients;
  195.   exit(0) unless @clients;
  196. }
  197.  
  198. sub _clientname {
  199.   my $name = shift;
  200.   "$name" =~ /^(.+)=[A-Z]+\(.+\)$/;
  201.   return $1;
  202. }
  203.  
  204. sub next {
  205.   my $s = shift;
  206.   $DB::single = 2;
  207.   $running = 1;
  208. }
  209.  
  210. sub step {
  211.   my $s = shift;
  212.   $DB::single = 1;
  213.   $running = 1;
  214. }
  215.  
  216. sub cont {
  217.   my $s = shift;
  218.   my $i = shift;
  219.   $s->set_tbreak($i) if $i;
  220.   for ($i = 0; $i <= $#stack;) {
  221.     $stack[$i++] &= ~1;
  222.   }
  223.   $DB::single = 0;
  224.   $running = 1;
  225. }
  226.  
  227. ####
  228. # XXX caller must experimentally determine $i (since it depends
  229. # on how many client call frames are between this call and the DB call).
  230. # Such is life.
  231. #
  232. sub ret {
  233.   my $s = shift;
  234.   my $i = shift;      # how many levels to get to DB sub
  235.   $i = 0 unless defined $i;
  236.   $stack[$#stack-$i] |= 1;
  237.   $DB::single = 0;
  238.   $running = 1;
  239. }
  240.  
  241. ####
  242. # XXX caller must experimentally determine $start (since it depends
  243. # on how many client call frames are between this call and the DB call).
  244. # Such is life.
  245. #
  246. sub backtrace {
  247.   my $self = shift;
  248.   my $start = shift;
  249.   my($p,$f,$l,$s,$h,$w,$e,$r,$a, @a, @ret,$i);
  250.   $start = 1 unless $start;
  251.   for ($i = $start; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
  252.     @a = @DB::args;
  253.     for (@a) {
  254.       s/'/\\'/g;
  255.       s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
  256.       s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
  257.       s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
  258.     }
  259.     $w = $w ? '@ = ' : '$ = ';
  260.     $a = $h ? '(' . join(', ', @a) . ')' : '';
  261.     $e =~ s/\n\s*\;\s*\Z// if $e;
  262.     $e =~ s/[\\\']/\\$1/g if $e;
  263.     if ($r) {
  264.       $s = "require '$e'";
  265.     } elsif (defined $r) {
  266.       $s = "eval '$e'";
  267.     } elsif ($s eq '(eval)') {
  268.       $s = "eval {...}";
  269.     }
  270.     $f = "file `$f'" unless $f eq '-e';
  271.     push @ret, "$w&$s$a from $f line $l";
  272.     last if $DB::signal;
  273.   }
  274.   return @ret;
  275. }
  276.  
  277. sub _outputall {
  278.   my $c;
  279.   for $c (@clients) {
  280.     $c->output(@_);
  281.   }
  282. }
  283.  
  284. sub trace_toggle {
  285.   my $s = shift;
  286.   $DB::trace = !$DB::trace;
  287. }
  288.  
  289.  
  290. ####
  291. # without args: returns all defined subroutine names
  292. # with subname args: returns a listref [file, start, end]
  293. #
  294. sub subs {
  295.   my $s = shift;
  296.   if (@_) {
  297.     my(@ret) = ();
  298.     while (@_) {
  299.       my $name = shift;
  300.       push @ret, [$DB::sub{$name} =~ /^(.*)\:(\d+)-(\d+)$/] 
  301.     if exists $DB::sub{$name};
  302.     }
  303.     return @ret;
  304.   }
  305.   return keys %DB::sub;
  306. }
  307.  
  308. ####
  309. # first argument is a filename whose subs will be returned
  310. # if a filename is not supplied, all subs in the current
  311. # filename are returned.
  312. #
  313. sub filesubs {
  314.   my $s = shift;
  315.   my $fname = shift;
  316.   $fname = $DB::filename unless $fname;
  317.   return grep { $DB::sub{$_} =~ /^$fname/ } keys %DB::sub;
  318. }
  319.  
  320. ####
  321. # returns a list of all filenames that DB knows about
  322. #
  323. sub files {
  324.   my $s = shift;
  325.   my(@f) = grep(m|^_<|, keys %main::);
  326.   return map { substr($_,2) } @f;
  327. }
  328.  
  329. ####
  330. # returns reference to an array holding the lines in currently
  331. # loaded file
  332. #
  333. sub lines {
  334.   my $s = shift;
  335.   return \@DB::dbline;
  336. }
  337.  
  338. ####
  339. # loadfile($file, $line)
  340. #
  341. sub loadfile {
  342.   my $s = shift;
  343.   my($file, $line) = @_;
  344.   if (!defined $main::{'_<' . $file}) {
  345.     my $try;
  346.     if (($try) = grep(m|^_<.*$file|, keys %main::)) {  
  347.       $file = substr($try,2);
  348.     }
  349.   }
  350.   if (defined($main::{'_<' . $file})) {
  351.     my $c;
  352. #    _outputall("Loading file $file..");
  353.     *DB::dbline = "::_<$file";
  354.     $DB::filename = $file;
  355.     for $c (@clients) {
  356. #      print "2 ", $file, '|', $line, "\n";
  357.       $c->showfile($file, $line);
  358.     }
  359.     return $file;
  360.   }
  361.   return undef;
  362. }
  363.  
  364. sub lineevents {
  365.   my $s = shift;
  366.   my $fname = shift;
  367.   my(%ret) = ();
  368.   my $i;
  369.   $fname = $DB::filename unless $fname;
  370.   local(*DB::dbline) = "::_<$fname";
  371.   for ($i = 1; $i <= $#DB::dbline; $i++) {
  372.     $ret{$i} = [$DB::dbline[$i], split(/\0/, $DB::dbline{$i})] 
  373.       if defined $DB::dbline{$i};
  374.   }
  375.   return %ret;
  376. }
  377.  
  378. sub set_break {
  379.   my $s = shift;
  380.   my $i = shift;
  381.   my $cond = shift;
  382.   $i ||= $DB::lineno;
  383.   $cond ||= '1';
  384.   $i = _find_subline($i) if ($i =~ /\D/);
  385.   $s->output("Subroutine not found.\n") unless $i;
  386.   if ($i) {
  387.     if ($DB::dbline[$i] == 0) {
  388.       $s->output("Line $i not breakable.\n");
  389.     }
  390.     else {
  391.       $DB::dbline{$i} =~ s/^[^\0]*/$cond/;
  392.     }
  393.   }
  394. }
  395.  
  396. sub set_tbreak {
  397.   my $s = shift;
  398.   my $i = shift;
  399.   $i = _find_subline($i) if ($i =~ /\D/);
  400.   $s->output("Subroutine not found.\n") unless $i;
  401.   if ($i) {
  402.     if ($DB::dbline[$i] == 0) {
  403.       $s->output("Line $i not breakable.\n");
  404.     }
  405.     else {
  406.       $DB::dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
  407.     }
  408.   }
  409. }
  410.  
  411. sub _find_subline {
  412.   my $name = shift;
  413.   $name =~ s/\'/::/;
  414.   $name = "${DB::package}\:\:" . $name if $name !~ /::/;
  415.   $name = "main" . $name if substr($name,0,2) eq "::";
  416.   my($fname, $from, $to) = ($DB::sub{$name} =~ /^(.*):(\d+)-(\d+)$/);
  417.   if ($from) {
  418.     local *DB::dbline = "::_<$fname";
  419.     ++$from while $DB::dbline[$from] == 0 && $from < $to;
  420.     return $from;
  421.   }
  422.   return undef;
  423. }
  424.  
  425. sub clr_breaks {
  426.   my $s = shift;
  427.   my $i;
  428.   if (@_) {
  429.     while (@_) {
  430.       $i = shift;
  431.       $i = _find_subline($i) if ($i =~ /\D/);
  432.       $s->output("Subroutine not found.\n") unless $i;
  433.       if (defined $DB::dbline{$i}) {
  434.         $DB::dbline{$i} =~ s/^[^\0]+//;
  435.         if ($DB::dbline{$i} =~ s/^\0?$//) {
  436.           delete $DB::dbline{$i};
  437.         }
  438.       }
  439.     }
  440.   }
  441.   else {
  442.     for ($i = 1; $i <= $#DB::dbline ; $i++) {
  443.       if (defined $DB::dbline{$i}) {
  444.         $DB::dbline{$i} =~ s/^[^\0]+//;
  445.         if ($DB::dbline{$i} =~ s/^\0?$//) {
  446.           delete $DB::dbline{$i};
  447.         }
  448.       }
  449.     }
  450.   }
  451. }
  452.  
  453. sub set_action {
  454.   my $s = shift;
  455.   my $i = shift;
  456.   my $act = shift;
  457.   $i = _find_subline($i) if ($i =~ /\D/);
  458.   $s->output("Subroutine not found.\n") unless $i;
  459.   if ($i) {
  460.     if ($DB::dbline[$i] == 0) {
  461.       $s->output("Line $i not actionable.\n");
  462.     }
  463.     else {
  464.       $DB::dbline{$i} =~ s/\0[^\0]*//;
  465.       $DB::dbline{$i} .= "\0" . $act;
  466.     }
  467.   }
  468. }
  469.  
  470. sub clr_actions {
  471.   my $s = shift;
  472.   my $i;
  473.   if (@_) {
  474.     while (@_) {
  475.       my $i = shift;
  476.       $i = _find_subline($i) if ($i =~ /\D/);
  477.       $s->output("Subroutine not found.\n") unless $i;
  478.       if ($i && $DB::dbline[$i] != 0) {
  479.     $DB::dbline{$i} =~ s/\0[^\0]*//;
  480.     delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
  481.       }
  482.     }
  483.   }
  484.   else {
  485.     for ($i = 1; $i <= $#DB::dbline ; $i++) {
  486.       if (defined $DB::dbline{$i}) {
  487.     $DB::dbline{$i} =~ s/\0[^\0]*//;
  488.     delete $DB::dbline{$i} if $DB::dbline{$i} =~ s/^\0?$//;
  489.       }
  490.     }
  491.   }
  492. }
  493.  
  494. sub prestop {
  495.   my ($client, $val) = @_;
  496.   return defined($val) ? $preeval->{$client} = $val : $preeval->{$client};
  497. }
  498.  
  499. sub poststop {
  500.   my ($client, $val) = @_;
  501.   return defined($val) ? $posteval->{$client} = $val : $posteval->{$client};
  502. }
  503.  
  504. #
  505. # "pure virtual" methods
  506. #
  507.  
  508. # client-specific pre/post-stop actions.
  509. sub cprestop {}
  510. sub cpoststop {}
  511.  
  512. # client complete startup
  513. sub awaken {}
  514.  
  515. sub skippkg {
  516.   my $s = shift;
  517.   push @skippkg, @_ if @_;
  518. }
  519.  
  520. sub evalcode {
  521.   my ($client, $val) = @_;
  522.   if (defined $val) {
  523.     $running = 2;    # hand over to DB() to evaluate in its context
  524.     $ineval->{$client} = $val;
  525.   }
  526.   return $ineval->{$client};
  527. }
  528.  
  529. sub ready {
  530.   my $s = shift;
  531.   return $ready = 1;
  532. }
  533.  
  534. # stubs
  535.     
  536. sub init {}
  537. sub stop {}
  538. sub idle {}
  539. sub cleanup {}
  540. sub output {}
  541.  
  542. #
  543. # client init
  544. #
  545. for (@clients) { $_->init }
  546.  
  547. $SIG{'INT'} = \&DB::catch;
  548.  
  549. # disable this if stepping through END blocks is desired
  550. # (looks scary and deconstructivist with Swat)
  551. END { $ready = 0 }
  552.  
  553. 1;
  554. __END__
  555.  
  556. =head1 NAME
  557.  
  558. DB - programmatic interface to the Perl debugging API
  559.  
  560. =head1 SYNOPSIS
  561.  
  562.     package CLIENT;
  563.     use DB;
  564.     @ISA = qw(DB);
  565.  
  566.     # these (inherited) methods can be called by the client
  567.  
  568.     CLIENT->register()      # register a client package name
  569.     CLIENT->done()          # de-register from the debugging API
  570.     CLIENT->skippkg('hide::hide')  # ask DB not to stop in this package
  571.     CLIENT->cont([WHERE])       # run some more (until BREAK or another breakpt)
  572.     CLIENT->step()              # single step
  573.     CLIENT->next()              # step over
  574.     CLIENT->ret()               # return from current subroutine
  575.     CLIENT->backtrace()         # return the call stack description
  576.     CLIENT->ready()             # call when client setup is done
  577.     CLIENT->trace_toggle()      # toggle subroutine call trace mode
  578.     CLIENT->subs([SUBS])        # return subroutine information
  579.     CLIENT->files()             # return list of all files known to DB
  580.     CLIENT->lines()             # return lines in currently loaded file
  581.     CLIENT->loadfile(FILE,LINE) # load a file and let other clients know
  582.     CLIENT->lineevents()        # return info on lines with actions
  583.     CLIENT->set_break([WHERE],[COND])
  584.     CLIENT->set_tbreak([WHERE])
  585.     CLIENT->clr_breaks([LIST])
  586.     CLIENT->set_action(WHERE,ACTION)
  587.     CLIENT->clr_actions([LIST])
  588.     CLIENT->evalcode(STRING)  # eval STRING in executing code's context
  589.     CLIENT->prestop([STRING]) # execute in code context before stopping
  590.     CLIENT->poststop([STRING])# execute in code context before resuming
  591.  
  592.     # These methods will be called at the appropriate times.
  593.     # Stub versions provided do nothing.
  594.     # None of these can block.
  595.  
  596.     CLIENT->init()          # called when debug API inits itself
  597.     CLIENT->stop(FILE,LINE) # when execution stops
  598.     CLIENT->idle()          # while stopped (can be a client event loop)
  599.     CLIENT->cleanup()       # just before exit
  600.     CLIENT->output(LIST)    # called to print any output that API must show
  601.  
  602. =head1 DESCRIPTION
  603.  
  604. Perl debug information is frequently required not just by debuggers,
  605. but also by modules that need some "special" information to do their
  606. job properly, like profilers.
  607.  
  608. This module abstracts and provides all of the hooks into Perl internal
  609. debugging functionality, so that various implementations of Perl debuggers
  610. (or packages that want to simply get at the "privileged" debugging data)
  611. can all benefit from the development of this common code.  Currently used
  612. by Swat, the perl/Tk GUI debugger.
  613.  
  614. Note that multiple "front-ends" can latch into this debugging API
  615. simultaneously.  This is intended to facilitate things like
  616. debugging with a command line and GUI at the same time, debugging 
  617. debuggers etc.  [Sounds nice, but this needs some serious support -- GSAR]
  618.  
  619. In particular, this API does B<not> provide the following functions:
  620.  
  621. =over 4
  622.  
  623. =item *
  624.  
  625. data display
  626.  
  627. =item *
  628.  
  629. command processing
  630.  
  631. =item *
  632.  
  633. command alias management
  634.  
  635. =item *
  636.  
  637. user interface (tty or graphical)
  638.  
  639. =back
  640.  
  641. These are intended to be services performed by the clients of this API.
  642.  
  643. This module attempts to be squeaky clean w.r.t C<use strict;> and when
  644. warnings are enabled.
  645.  
  646.  
  647. =head2 Global Variables
  648.  
  649. The following "public" global names can be read by clients of this API.
  650. Beware that these should be considered "readonly".
  651.  
  652. =over 8
  653.  
  654. =item  $DB::sub
  655.  
  656. Name of current executing subroutine.
  657.  
  658. =item  %DB::sub
  659.  
  660. The keys of this hash are the names of all the known subroutines.  Each value
  661. is an encoded string that has the sprintf(3) format 
  662. C<("%s:%d-%d", filename, fromline, toline)>.
  663.  
  664. =item  $DB::single
  665.  
  666. Single-step flag.  Will be true if the API will stop at the next statement.
  667.  
  668. =item  $DB::signal
  669.  
  670. Signal flag. Will be set to a true value if a signal was caught.  Clients may
  671. check for this flag to abort time-consuming operations.
  672.  
  673. =item  $DB::trace
  674.  
  675. This flag is set to true if the API is tracing through subroutine calls.
  676.  
  677. =item  @DB::args
  678.  
  679. Contains the arguments of current subroutine, or the C<@ARGV> array if in the 
  680. toplevel context.
  681.  
  682. =item  @DB::dbline
  683.  
  684. List of lines in currently loaded file.
  685.  
  686. =item  %DB::dbline
  687.  
  688. Actions in current file (keys are line numbers).  The values are strings that
  689. have the sprintf(3) format C<("%s\000%s", breakcondition, actioncode)>. 
  690.  
  691. =item  $DB::package
  692.  
  693. Package namespace of currently executing code.
  694.  
  695. =item  $DB::filename
  696.  
  697. Currently loaded filename.
  698.  
  699. =item  $DB::subname
  700.  
  701. Fully qualified name of currently executing subroutine.
  702.  
  703. =item  $DB::lineno
  704.  
  705. Line number that will be executed next.
  706.  
  707. =back
  708.  
  709. =head2 API Methods
  710.  
  711. The following are methods in the DB base class.  A client must
  712. access these methods by inheritance (*not* by calling them directly),
  713. since the API keeps track of clients through the inheritance
  714. mechanism.
  715.  
  716. =over 8
  717.  
  718. =item CLIENT->register()
  719.  
  720. register a client object/package
  721.  
  722. =item CLIENT->evalcode(STRING)
  723.  
  724. eval STRING in executing code context
  725.  
  726. =item CLIENT->skippkg('D::hide')
  727.  
  728. ask DB not to stop in these packages
  729.  
  730. =item CLIENT->run()
  731.  
  732. run some more (until a breakpt is reached)
  733.  
  734. =item CLIENT->step()
  735.  
  736. single step
  737.  
  738. =item CLIENT->next()
  739.  
  740. step over
  741.  
  742. =item CLIENT->done()
  743.  
  744. de-register from the debugging API
  745.  
  746. =back
  747.  
  748. =head2 Client Callback Methods
  749.  
  750. The following "virtual" methods can be defined by the client.  They will
  751. be called by the API at appropriate points.  Note that unless specified
  752. otherwise, the debug API only defines empty, non-functional default versions
  753. of these methods.
  754.  
  755. =over 8
  756.  
  757. =item CLIENT->init()
  758.  
  759. Called after debug API inits itself.
  760.  
  761. =item CLIENT->prestop([STRING])
  762.  
  763. Usually inherited from DB package.  If no arguments are passed,
  764. returns the prestop action string.
  765.  
  766. =item CLIENT->stop()
  767.  
  768. Called when execution stops (w/ args file, line).
  769.  
  770. =item CLIENT->idle()
  771.  
  772. Called while stopped (can be a client event loop).
  773.  
  774. =item CLIENT->poststop([STRING])
  775.  
  776. Usually inherited from DB package.  If no arguments are passed,
  777. returns the poststop action string.
  778.  
  779. =item CLIENT->evalcode(STRING)
  780.  
  781. Usually inherited from DB package.  Ask for a STRING to be C<eval>-ed
  782. in executing code context.
  783.  
  784. =item CLIENT->cleanup()
  785.  
  786. Called just before exit.
  787.  
  788. =item CLIENT->output(LIST)
  789.  
  790. Called when API must show a message (warnings, errors etc.).
  791.  
  792.  
  793. =back
  794.  
  795.  
  796. =head1 BUGS
  797.  
  798. The interface defined by this module is missing some of the later additions
  799. to perl's debugging functionality.  As such, this interface should be considered
  800. highly experimental and subject to change.
  801.  
  802. =head1 AUTHOR
  803.  
  804. Gurusamy Sarathy    gsar@activestate.com
  805.  
  806. This code heavily adapted from an early version of perl5db.pl attributable
  807. to Larry Wall and the Perl Porters.
  808.  
  809. =cut
  810.